home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / kcl.lha / cmpnew / cmputil.c < prev    next >
C/C++ Source or Header  |  1987-06-04  |  17KB  |  743 lines
  1.  
  2. /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
  3. #include <cmpinclude.h>
  4. #include "cmputil.h"
  5. init_cmputil(start,size,data)char *start;int size;object data;
  6. {    register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
  7.     Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
  8.     MM(VV[70],L1,start,size,data);
  9.     VV[3]->s.s_stype=(short)stp_special;
  10.     if(VV[3]->s.s_dbind == OBJNULL){
  11.     VV[3]->s.s_dbind = VV[2];}
  12.     VV[4]->s.s_stype=(short)stp_special;
  13.     if(VV[4]->s.s_dbind == OBJNULL){
  14.     VV[4]->s.s_dbind = Ct;}
  15.     VV[6]->s.s_stype=(short)stp_special;
  16.     if(VV[6]->s.s_dbind == OBJNULL){
  17.     VV[6]->s.s_dbind = VV[5];}
  18.     base[0]= VV[7];
  19.     base[1]= make_cons(Cnil,Cnil);
  20.     (void)simple_symlispcall_no_event(VV[71],base+0,2);
  21.     data->v.v_self[12]=VV[12]=string_to_object(VV[12]);
  22.     vs_top=sup;
  23.     MF(VV[14],L4,start,size,data);
  24.     MM(VV[72],L5,start,size,data);
  25.     MF(VV[73],L6,start,size,data);
  26.     MF(VV[74],L7,start,size,data);
  27.     VV[17]->s.s_stype=(short)stp_special;
  28.     if(VV[17]->s.s_dbind == OBJNULL){
  29.     VV[17]->s.s_dbind = Cnil;}
  30.     MF(VV[75],L8,start,size,data);
  31.     VV[19]->s.s_stype=(short)stp_special;
  32.     if(VV[19]->s.s_dbind == OBJNULL){
  33.     VV[19]->s.s_dbind = Cnil;}
  34.     MF(VV[76],L9,start,size,data);
  35.     MF(VV[77],L10,start,size,data);
  36.     MF(VV[78],L11,start,size,data);
  37.     MF(VV[79],L12,start,size,data);
  38.     MM(VV[80],L13,start,size,data);
  39.     MM(VV[81],L14,start,size,data);
  40.     MM(VV[82],L15,start,size,data);
  41.     MM(VV[83],L16,start,size,data);
  42.     MF(VV[84],L17,start,size,data);
  43.     MF(VV[85],L18,start,size,data);
  44.     MF(VV[86],L19,start,size,data);
  45.     MF(VV[87],L20,start,size,data);
  46.     VV[52]->s.s_stype=(short)stp_special;
  47.     if(VV[52]->s.s_dbind == OBJNULL){
  48.     VV[52]->s.s_dbind = Cnil;}
  49.     MF(VV[88],L21,start,size,data);
  50.     MF(VV[89],L22,start,size,data);
  51.     vs_top=vs_base=base;
  52. }
  53. /*    macro definition for SAFE-COMPILE    */
  54.  
  55. static L1()
  56. {    register object *base=vs_base;
  57.     register object *sup=base+VM3;
  58.     vs_reserve(VM3);
  59.     check_arg(2);
  60.     vs_top=sup;
  61.     {object V1=base[0]->c.c_cdr;
  62.     base[2]= V1;}
  63.     base[3]= listA(3,VV[0],VV[1],base[2]);
  64.     vs_top=(vs_base=base+3)+1;
  65.     return;
  66. }
  67. /*    function definition for CMPERR    */
  68.  
  69. static L4()
  70. {    register object *base=vs_base;
  71.     register object *sup=base+VM4;
  72.     vs_reserve(VM4);
  73.     bds_check;
  74.     if(vs_top-vs_base<1) too_few_arguments();
  75.     vs_base=vs_base+1;
  76.     vs_top[0]=Cnil;
  77.     {object *p=vs_top;
  78.      for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
  79.     vs_top=sup;
  80.     bds_bind(VV[9],VV[8]);
  81.     vs_base=vs_top;
  82.     L10();
  83.     vs_top=sup;
  84.     base[3]= Ct;
  85.     base[4]= VV[10];
  86.     vs_top=(vs_base=base+3)+2;
  87.     Lformat();
  88.     vs_top=sup;
  89.     base[3]= Ct;
  90.     base[4]= base[0];
  91.     {object V2;
  92.     V2= base[1];
  93.      vs_top=base+5;
  94.      while(!endp(V2))
  95.      {vs_push(car(V2));V2=cdr(V2);}
  96.     vs_base=base+3;}
  97.     Lformat();
  98.     vs_top=sup;
  99.     setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
  100.     {frame_ptr fr;
  101.     fr=frs_sch_catch(VV[12]);
  102.     if(fr==NULL) FEerror("The tag ~s is undefined.",1,VV[12]);
  103.     base[3]= VV[7];
  104.     vs_top=(vs_base=base+3)+1;
  105.     unwind(fr,VV[12]);}
  106. }
  107. /*    macro definition for CMPCK    */
  108.  
  109. static L5()
  110. {    register object *base=vs_base;
  111.     register object *sup=base+VM5;
  112.     vs_reserve(VM5);
  113.     check_arg(2);
  114.     vs_top=sup;
  115.     {object V3=base[0]->c.c_cdr;
  116.     if(endp(V3))invalid_macro_call();
  117.     base[2]= (V3->c.c_car);
  118.     V3=V3->c.c_cdr;
  119.     if(endp(V3))invalid_macro_call();
  120.     base[3]= (V3->c.c_car);
  121.     V3=V3->c.c_cdr;
  122.     base[4]= V3;}
  123.     base[5]= listA(3,VV[14],base[3],base[4]);
  124.     base[6]= list(3,VV[13],base[2],base[5]);
  125.     vs_top=(vs_base=base+6)+1;
  126.     return;
  127. }
  128. /*    function definition for TOO-MANY-ARGS    */
  129.  
  130. static L6()
  131. {    register object *base=vs_base;
  132.     register object *sup=base+VM6;
  133.     vs_reserve(VM6);
  134.     bds_check;
  135.     check_arg(3);
  136.     vs_top=sup;
  137. TTL:;
  138.     bds_bind(VV[9],VV[8]);
  139.     vs_base=vs_top;
  140.     L10();
  141.     vs_top=sup;
  142.     base[4]= Ct;
  143.     base[5]= VV[15];
  144.     base[6]= base[0];
  145.     base[7]= base[1];
  146.     base[8]= base[2];
  147.     vs_top=(vs_base=base+4)+5;
  148.     Lformat();
  149.     vs_top=sup;
  150.     setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
  151.     {frame_ptr fr;
  152.     fr=frs_sch_catch(VV[12]);
  153.     if(fr==NULL) FEerror("The tag ~s is undefined.",1,VV[12]);
  154.     base[4]= VV[7];
  155.     vs_top=(vs_base=base+4)+1;
  156.     unwind(fr,VV[12]);}
  157. }
  158. /*    function definition for TOO-FEW-ARGS    */
  159.  
  160. static L7()
  161. {    register object *base=vs_base;
  162.     register object *sup=base+VM7;
  163.     vs_reserve(VM7);
  164.     bds_check;
  165.     check_arg(3);
  166.     vs_top=sup;
  167. TTL:;
  168.     bds_bind(VV[9],VV[8]);
  169.     vs_base=vs_top;
  170.     L10();
  171.     vs_top=sup;
  172.     base[4]= Ct;
  173.     base[5]= VV[16];
  174.     base[6]= base[0];
  175.     base[7]= base[1];
  176.     base[8]= base[2];
  177.     vs_top=(vs_base=base+4)+5;
  178.     Lformat();
  179.     vs_top=sup;
  180.     setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
  181.     {frame_ptr fr;
  182.     fr=frs_sch_catch(VV[12]);
  183.     if(fr==NULL) FEerror("The tag ~s is undefined.",1,VV[12]);
  184.     base[4]= VV[7];
  185.     vs_top=(vs_base=base+4)+1;
  186.     unwind(fr,VV[12]);}
  187. }
  188. /*    function definition for CMPWARN    */
  189.  
  190. static L8()
  191. {    register object *base=vs_base;
  192.     register object *sup=base+VM8;
  193.     vs_reserve(VM8);
  194.     bds_check;
  195.     if(vs_top-vs_base<1) too_few_arguments();
  196.     vs_base=vs_base+1;
  197.     vs_top[0]=Cnil;
  198.     {object *p=vs_top;
  199.      for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
  200.     vs_top=sup;
  201.     bds_bind(VV[9],VV[8]);
  202.     if((symbol_value(VV[17]))!=Cnil){
  203.     goto T42;}
  204.     vs_base=vs_top;
  205.     L10();
  206.     vs_top=sup;
  207.     base[3]= Ct;
  208.     base[4]= VV[18];
  209.     vs_top=(vs_base=base+3)+2;
  210.     Lformat();
  211.     vs_top=sup;
  212.     base[3]= Ct;
  213.     base[4]= base[0];
  214.     {object V4;
  215.     V4= base[1];
  216.      vs_top=base+5;
  217.      while(!endp(V4))
  218.      {vs_push(car(V4));V4=cdr(V4);}
  219.     vs_base=base+3;}
  220.     Lformat();
  221.     vs_top=sup;
  222.     princ_char(10,Cnil);
  223. T42:;
  224.     base[3]= Cnil;
  225.     vs_top=(vs_base=base+3)+1;
  226.     bds_unwind1;
  227.     return;
  228. }
  229. /*    function definition for CMPNOTE    */
  230.  
  231. static L9()
  232. {    register object *base=vs_base;
  233.     register object *sup=base+VM9;
  234.     vs_reserve(VM9);
  235.     bds_check;
  236.     if(vs_top-vs_base<1) too_few_arguments();
  237.     vs_base=vs_base+1;
  238.     vs_top[0]=Cnil;
  239.     {object *p=vs_top;
  240.      for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
  241.     vs_top=sup;
  242.     bds_bind(VV[9],VV[8]);
  243.     if((symbol_value(VV[19]))!=Cnil){
  244.     goto T53;}
  245.     princ_char(10,Cnil);
  246.     base[3]= Ct;
  247.     base[4]= VV[20];
  248.     vs_top=(vs_base=base+3)+2;
  249.     Lformat();
  250.     vs_top=sup;
  251.     base[3]= Ct;
  252.     base[4]= base[0];
  253.     {object V5;
  254.     V5= base[1];
  255.      vs_top=base+5;
  256.      while(!endp(V5))
  257.      {vs_push(car(V5));V5=cdr(V5);}
  258.     vs_base=base+3;}
  259.     Lformat();
  260.     vs_top=sup;
  261. T53:;
  262.     base[3]= Cnil;
  263.     vs_top=(vs_base=base+3)+1;
  264.     bds_unwind1;
  265.     return;
  266. }
  267. /*    function definition for PRINT-CURRENT-FORM    */
  268.  
  269. static L10()
  270. {    register object *base=vs_base;
  271.     register object *sup=base+VM10;
  272.     vs_reserve(VM10);
  273.     bds_check;
  274.     check_arg(0);
  275.     vs_top=sup;
  276. TTL:;
  277.     if((symbol_value(VV[4]))==Cnil){
  278.     goto T63;}
  279.     setq(VV[4],Cnil);
  280.     vs_base=vs_top;
  281.     Lfresh_line();
  282.     vs_top=sup;
  283.     if(!(type_of(symbol_value(VV[3]))==t_cons)){
  284.     goto T70;}
  285.     if(!(car(symbol_value(VV[3]))==VV[21])){
  286.     goto T70;}
  287.     base[0]= Ct;
  288.     base[1]= VV[22];
  289.     base[2]= cdr(symbol_value(VV[3]));
  290.     vs_top=(vs_base=base+0)+3;
  291.     Lformat();
  292.     vs_top=sup;
  293.     goto T63;
  294. T70:;
  295.     bds_bind(VV[23],VV[24]);
  296.     bds_bind(VV[25],VV[24]);
  297.     base[2]= Ct;
  298.     base[3]= VV[26];
  299.     base[4]= symbol_value(VV[3]);
  300.     vs_top=(vs_base=base+2)+3;
  301.     Lformat();
  302.     vs_top=sup;
  303.     bds_unwind1;
  304.     bds_unwind1;
  305. T63:;
  306.     base[0]= Cnil;
  307.     vs_top=(vs_base=base+0)+1;
  308.     return;
  309. }
  310. /*    function definition for UNDEFINED-VARIABLE    */
  311.  
  312. static L11()
  313. {    register object *base=vs_base;
  314.     register object *sup=base+VM11;
  315.     vs_reserve(VM11);
  316.     bds_check;
  317.     check_arg(1);
  318.     vs_top=sup;
  319. TTL:;
  320.     bds_bind(VV[9],VV[8]);
  321.     vs_base=vs_top;
  322.     L10();
  323.     vs_top=sup;
  324.     base[2]= Ct;
  325.     base[3]= VV[27];
  326.     base[4]= base[0];
  327.     vs_top=(vs_base=base+2)+3;
  328.     Lformat();
  329.     vs_top=sup;
  330.     base[2]= Cnil;
  331.     vs_top=(vs_base=base+2)+1;
  332.     bds_unwind1;
  333.     return;
  334. }
  335. /*    function definition for BABOON    */
  336.  
  337. static L12()
  338. {    register object *base=vs_base;
  339.     register object *sup=base+VM12;
  340.     vs_reserve(VM12);
  341.     bds_check;
  342.     check_arg(0);
  343.     vs_top=sup;
  344. TTL:;
  345.     bds_bind(VV[9],VV[8]);
  346.     vs_base=vs_top;
  347.     L10();
  348.     vs_top=sup;
  349.     base[1]= Ct;
  350.     base[2]= VV[28];
  351.     vs_top=(vs_base=base+1)+2;
  352.     Lformat();
  353.     vs_top=sup;
  354.     setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
  355.     symlispcall_no_event(VV[90],base+1,0);
  356.     bds_unwind1;
  357.     return;
  358. }
  359. /*    macro definition for DOLIST*    */
  360.  
  361. static L13()
  362. {    register object *base=vs_base;
  363.     register object *sup=base+VM13;
  364.     vs_reserve(VM13);
  365.     check_arg(2);
  366.     vs_top=sup;
  367.     {object V6=base[0]->c.c_cdr;
  368.     if(endp(V6))invalid_macro_call();
  369.     {object V7= (V6->c.c_car);
  370.     if(endp(V7))invalid_macro_call();
  371.     base[2]= (V7->c.c_car);
  372.     V7=V7->c.c_cdr;
  373.     if(endp(V7))invalid_macro_call();
  374.     base[3]= (V7->c.c_car);
  375.     V7=V7->c.c_cdr;
  376.     if(endp(V7)){
  377.     base[4]= Cnil;
  378.     } else {
  379.     base[4]= (V7->c.c_car);
  380.     V7=V7->c.c_cdr;}
  381.     if(!endp(V7))invalid_macro_call();}
  382.     V6=V6->c.c_cdr;
  383.     base[5]= V6;}
  384.     vs_base=vs_top;
  385.     Lgensym();
  386.     vs_top=sup;
  387.     base[6]= vs_base[0];
  388.     base[7]= list(2,VV[30],base[6]);
  389.     base[8]= list(3,base[6],base[3],base[7]);
  390.     base[9]= list(2,VV[31],base[6]);
  391.     base[10]= list(2,VV[31],base[6]);
  392.     base[11]= list(3,base[2],base[9],base[10]);
  393.     base[12]= list(2,base[8],base[11]);
  394.     base[13]= list(2,VV[32],base[6]);
  395.     base[14]= list(2,base[13],base[4]);
  396.     base[15]= list(2,VV[34],base[2]);
  397.     base[16]= list(2,VV[33],base[15]);
  398.     base[17]= listA(5,VV[29],base[12],base[14],base[16],base[5]);
  399.     vs_top=(vs_base=base+17)+1;
  400.     return;
  401. }
  402. /*    macro definition for DOLIST**    */
  403.  
  404. static L14()
  405. {    register object *base=vs_base;
  406.     register object *sup=base+VM14;
  407.     vs_reserve(VM14);
  408.     check_arg(2);
  409.     vs_top=sup;
  410.     {object V8=base[0]->c.c_cdr;
  411.     if(endp(V8))invalid_macro_call();
  412.     {object V9= (V8->c.c_car);
  413.     if(endp(V9))invalid_macro_call();
  414.     base[2]= (V9->c.c_car);
  415.     V9=V9->c.c_cdr;
  416.     if(endp(V9))invalid_macro_call();
  417.     base[3]= (V9->c.c_car);
  418.     V9=V9->c.c_cdr;
  419.     if(endp(V9)){
  420.     base[4]= Cnil;
  421.     } else {
  422.     base[4]= (V9->c.c_car);
  423.     V9=V9->c.c_cdr;}
  424.     if(!endp(V9))invalid_macro_call();}
  425.     V8=V8->c.c_cdr;
  426.     base[5]= V8;}
  427.     vs_base=vs_top;
  428.     Lgensym();
  429.     vs_top=sup;
  430.     base[6]= vs_base[0];
  431.     base[7]= list(2,VV[30],base[6]);
  432.     base[8]= list(3,base[6],base[3],base[7]);
  433.     base[9]= list(2,VV[31],base[6]);
  434.     base[10]= list(2,VV[31],base[6]);
  435.     base[11]= list(3,base[2],base[9],base[10]);
  436.     base[12]= list(2,base[8],base[11]);
  437.     base[13]= list(2,VV[32],base[6]);
  438.     base[14]= list(2,base[13],base[4]);
  439.     base[15]= list(3,VV[34],base[6],base[2]);
  440.     base[16]= list(2,VV[33],base[15]);
  441.     base[17]= listA(5,VV[29],base[12],base[14],base[16],base[5]);
  442.     vs_top=(vs_base=base+17)+1;
  443.     return;
  444. }
  445. /*    macro definition for DOTIMES*    */
  446.  
  447. static L15()
  448. {    register object *base=vs_base;
  449.     register object *sup=base+VM15;
  450.     vs_reserve(VM15);
  451.     check_arg(2);
  452.     vs_top=sup;
  453.     {object V10=base[0]->c.c_cdr;
  454.     if(endp(V10))invalid_macro_call();
  455.     {object V11= (V10->c.c_car);
  456.     if(endp(V11))invalid_macro_call();
  457.     base[2]= (V11->c.c_car);
  458.     V11=V11->c.c_cdr;
  459.     if(endp(V11))invalid_macro_call();
  460.     base[3]= (V11->c.c_car);
  461.     V11=V11->c.c_cdr;
  462.     if(endp(V11)){
  463.     base[4]= Cnil;
  464.     } else {
  465.     base[4]= (V11->c.c_car);
  466.     V11=V11->c.c_cdr;}
  467.     if(!endp(V11))invalid_macro_call();}
  468.     V10=V10->c.c_cdr;
  469.     base[5]= V10;}
  470.     vs_base=vs_top;
  471.     Lgensym();
  472.     vs_top=sup;
  473.     base[6]= vs_base[0];
  474.     base[7]= list(2,base[6],base[3]);
  475.     base[8]= list(2,VV[35],base[2]);
  476.     base[9]= list(3,base[2],VV[5],base[8]);
  477.     base[10]= list(2,base[7],base[9]);
  478.     base[11]= list(3,VV[36],base[2],base[6]);
  479.     base[12]= list(2,base[11],base[4]);
  480.     base[13]= list(2,VV[37],base[2]);
  481.     base[14]= list(2,VV[33],base[13]);
  482.     base[15]= listA(5,VV[29],base[10],base[12],base[14],base[5]);
  483.     vs_top=(vs_base=base+15)+1;
  484.     return;
  485. }
  486. /*    macro definition for DOTIMES**    */
  487.  
  488. static L16()
  489. {    register object *base=vs_base;
  490.     register object *sup=base+VM16;
  491.     vs_reserve(VM16);
  492.     check_arg(2);
  493.     vs_top=sup;
  494.     {object V12=base[0]->c.c_cdr;
  495.     if(endp(V12))invalid_macro_call();
  496.     {object V13= (V12->c.c_car);
  497.     if(endp(V13))invalid_macro_call();
  498.     base[2]= (V13->c.c_car);
  499.     V13=V13->c.c_cdr;
  500.     if(endp(V13))invalid_macro_call();
  501.     base[3]= (V13->c.c_car);
  502.     V13=V13->c.c_cdr;
  503.     if(endp(V13)){
  504.     base[4]= Cnil;
  505.     } else {
  506.     base[4]= (V13->c.c_car);
  507.     V13=V13->c.c_cdr;}
  508.     if(!endp(V13))invalid_macro_call();}
  509.     V12=V12->c.c_cdr;
  510.     base[5]= V12;}
  511.     vs_base=vs_top;
  512.     Lgensym();
  513.     vs_top=sup;
  514.     base[6]= vs_base[0];
  515.     base[7]= list(2,base[6],base[3]);
  516.     base[8]= list(2,VV[35],base[2]);
  517.     base[9]= list(3,base[2],VV[5],base[8]);
  518.     base[10]= list(2,base[7],base[9]);
  519.     base[11]= list(3,VV[36],base[2],base[6]);
  520.     base[12]= list(2,base[11],base[4]);
  521.     base[13]= list(3,VV[37],base[6],base[2]);
  522.     base[14]= list(2,VV[33],base[13]);
  523.     base[15]= listA(5,VV[29],base[10],base[12],base[14],base[5]);
  524.     vs_top=(vs_base=base+15)+1;
  525.     return;
  526. }
  527. /*    function definition for CMP-EVAL    */
  528.  
  529. static L17()
  530. {    register object *base=vs_base;
  531.     register object *sup=base+VM17;
  532.     vs_reserve(VM17);
  533.     bds_check;
  534.     check_arg(1);
  535.     vs_top=sup;
  536. TTL:;
  537.     base[3]= list(2,VV[39],base[0]);
  538.     base[2]= list(2,VV[38],base[3]);
  539.     vs_top=(vs_base=base+2)+1;
  540.     L21();
  541.     Llist();
  542.     vs_top=sup;
  543.     base[1]= vs_base[0];
  544.     if((car(base[1]))==Cnil){
  545.     goto T103;}
  546.     bds_bind(VV[9],VV[8]);
  547.     setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
  548.     vs_base=vs_top;
  549.     L10();
  550.     vs_top=sup;
  551.     base[3]= Ct;
  552.     base[4]= VV[40];
  553.     base[5]= base[0];
  554.     vs_top=(vs_base=base+3)+3;
  555.     Lformat();
  556.     vs_top=sup;
  557.     base[3]= Cnil;
  558.     vs_top=(vs_base=base+3)+1;
  559.     bds_unwind1;
  560.     return;
  561. T103:;
  562.     base[2]= cdr(base[1]);
  563.     vs_top=(vs_base=base+2)+1;
  564.     Lvalues_list();
  565.     return;
  566. }
  567. /*    function definition for CMP-MACROEXPAND    */
  568.  
  569. static L18()
  570. {    register object *base=vs_base;
  571.     register object *sup=base+VM18;
  572.     vs_reserve(VM18);
  573.     bds_check;
  574.     check_arg(1);
  575.     vs_top=sup;
  576. TTL:;
  577.     base[3]= list(2,VV[39],base[0]);
  578.     base[2]= list(2,VV[41],base[3]);
  579.     vs_top=(vs_base=base+2)+1;
  580.     L21();
  581.     Llist();
  582.     vs_top=sup;
  583.     base[1]= vs_base[0];
  584.     if((car(base[1]))==Cnil){
  585.     goto T117;}
  586.     bds_bind(VV[9],VV[8]);
  587.     setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
  588.     vs_base=vs_top;
  589.     L10();
  590.     vs_top=sup;
  591.     base[3]= Ct;
  592.     base[4]= VV[42];
  593.     base[5]= base[0];
  594.     vs_top=(vs_base=base+3)+3;
  595.     Lformat();
  596.     vs_top=sup;
  597.     base[3]= list(2,VV[39],base[0]);
  598.     base[4]= list(3,VV[43],VV[44],base[3]);
  599.     vs_top=(vs_base=base+4)+1;
  600.     bds_unwind1;
  601.     return;
  602. T117:;
  603.     base[2]= cadr(base[1]);
  604.     vs_top=(vs_base=base+2)+1;
  605.     return;
  606. }
  607. /*    function definition for CMP-MACROEXPAND-1    */
  608.  
  609. static L19()
  610. {    register object *base=vs_base;
  611.     register object *sup=base+VM19;
  612.     vs_reserve(VM19);
  613.     bds_check;
  614.     check_arg(1);
  615.     vs_top=sup;
  616. TTL:;
  617.     base[3]= list(2,VV[39],base[0]);
  618.     base[2]= list(2,VV[45],base[3]);
  619.     vs_top=(vs_base=base+2)+1;
  620.     L21();
  621.     Llist();
  622.     vs_top=sup;
  623.     base[1]= vs_base[0];
  624.     if((car(base[1]))==Cnil){
  625.     goto T130;}
  626.     bds_bind(VV[9],VV[8]);
  627.     setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
  628.     vs_base=vs_top;
  629.     L10();
  630.     vs_top=sup;
  631.     base[3]= Ct;
  632.     base[4]= VV[46];
  633.     base[5]= base[0];
  634.     vs_top=(vs_base=base+3)+3;
  635.     Lformat();
  636.     vs_top=sup;
  637.     base[3]= list(2,VV[39],base[0]);
  638.     base[4]= list(3,VV[43],VV[47],base[3]);
  639.     vs_top=(vs_base=base+4)+1;
  640.     bds_unwind1;
  641.     return;
  642. T130:;
  643.     base[2]= cadr(base[1]);
  644.     vs_top=(vs_base=base+2)+1;
  645.     return;
  646. }
  647. /*    function definition for CMP-EXPAND-MACRO    */
  648.  
  649. static L20()
  650. {    register object *base=vs_base;
  651.     register object *sup=base+VM20;
  652.     vs_reserve(VM20);
  653.     bds_check;
  654.     check_arg(3);
  655.     vs_top=sup;
  656. TTL:;
  657.     base[5]= list(2,VV[39],base[0]);
  658.     base[6]= make_cons(base[1],base[2]);
  659.     base[7]= list(2,VV[39],base[6]);
  660.     base[4]= list(5,VV[48],VV[49],base[5],base[7],Cnil);
  661.     vs_top=(vs_base=base+4)+1;
  662.     L21();
  663.     Llist();
  664.     vs_top=sup;
  665.     base[3]= vs_base[0];
  666.     if((car(base[3]))==Cnil){
  667.     goto T143;}
  668.     bds_bind(VV[9],VV[8]);
  669.     setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
  670.     vs_base=vs_top;
  671.     L10();
  672.     vs_top=sup;
  673.     base[5]= Ct;
  674.     base[6]= VV[50];
  675.     base[7]= base[1];
  676.     vs_top=(vs_base=base+5)+3;
  677.     Lformat();
  678.     vs_top=sup;
  679.     base[5]= make_cons(base[1],base[2]);
  680.     base[6]= list(2,VV[39],base[5]);
  681.     base[7]= list(3,VV[43],VV[51],base[6]);
  682.     vs_top=(vs_base=base+7)+1;
  683.     bds_unwind1;
  684.     return;
  685. T143:;
  686.     base[4]= cadr(base[3]);
  687.     vs_top=(vs_base=base+4)+1;
  688.     return;
  689. }
  690. /*    function definition for CMP-TOPLEVEL-EVAL    */
  691.  
  692. static L21()
  693. {    register object *base=vs_base;
  694.     register object *sup=base+VM21;
  695.     vs_reserve(VM21);
  696.     bds_check;
  697.     check_arg(1);
  698.     vs_top=sup;
  699. TTL:;
  700.     bds_bind(VV[53],symbol_value(VV[54]));
  701.     base[3]= simple_symlispcall_no_event(VV[91],base+4,0);
  702.     bds_bind(VV[54],one_minus(base[3]));
  703.     bds_bind(VV[55],symbol_value(VV[52]));
  704.     base[6]= VV[57];
  705.     vs_top=(vs_base=base+6)+1;
  706.     Lfind_package();
  707.     vs_top=sup;
  708.     base[5]= vs_base[0];
  709.     bds_bind(VV[56],make_cons(base[5],symbol_value(VV[56])));
  710.     base[5]= base[0];
  711.     vs_top=(vs_base=base+5)+1;
  712.     siLerror_set();
  713.     bds_unwind1;
  714.     bds_unwind1;
  715.     bds_unwind1;
  716.     bds_unwind1;
  717.     return;
  718. }
  719. /*    function definition for COMPILER-CLEAR-COMPILER-PROPERTIES    */
  720.  
  721. static L22()
  722. {    register object *base=vs_base;
  723.     register object *sup=base+VM22;
  724.     vs_reserve(VM22);
  725.     check_arg(1);
  726.     vs_top=sup;
  727. TTL:;
  728.     (void)(remprop(base[0],VV[58]));
  729.     (void)(remprop(base[0],VV[59]));
  730.     (void)(remprop(base[0],VV[60]));
  731.     (void)(remprop(base[0],VV[61]));
  732.     (void)(remprop(base[0],VV[62]));
  733.     (void)(remprop(base[0],VV[63]));
  734.     (void)(remprop(base[0],VV[64]));
  735.     (void)(remprop(base[0],VV[65]));
  736.     (void)(remprop(base[0],VV[66]));
  737.     (void)(remprop(base[0],VV[67]));
  738.     (void)(remprop(base[0],VV[68]));
  739.     base[1]= remprop(base[0],VV[69]);
  740.     vs_top=(vs_base=base+1)+1;
  741.     return;
  742. }
  743.